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Option Explicit 

Public workingDirectory As String 
Public targetFolder As String 
Public conversionsFolder As String 
Public footerExists As Boolean 
Public bottomRule As Booleln 
Public moduleName As String 
Public moduleGif As String 
Public moduleGif 2 As String 

ESS L^Ln, «*> »™ " *~> — 

Public linkMapWindow As ' String 
Public docMapWindow As Strfng 

Sub MainRoutine ( ) 



3" -"s 

Appl&ation.DisplayScrollBars = False 
'Application. DisplayStatusBar = False 
Application. ScreenUpdating = False 



This is the main routine that runs the whole conversion shebang 
ignore (for now) the following files: 



> ***=!= 

• ***in 

*.art 

1**+^ signon.* 
f ***EQ menu.* 



Dim currFile As String 
KJm namePart As String 
Bjm extPart As String 
©im saveName As String 
Dim messageText As String 



currFile = "" 
saveName = "" 
namePart = 
extPart = 



messageText = "Enter module code:" & vbCr & 

"AHA - Adult Health Advisor" & vbCr & 
"PA - Pediatric Health Advisor" & vbCr~& 
"BHA' - Behavioural Health Advisor" & vbCr~ 
"WHA ? - Women's Health Advisor" & vbCr & 
■'SHA - Senior Health Advisor" & vbCr & ~ 
"CA - Cardiac Health Advisor" & vbCr £ 
•|0A - Ophthalmology Health Advisor" & vbCr 
'•SMA - Sports Medicine Advisor" £ vbCr & 
"MA - Medications Advisor" & vbCr "~ 

moduleName = InputBox (messageText, "Module Name Entry", "AHA") 
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tweakModuleName , _ 

workingDirectory = gefeArticlePath^ M J J b *J? d ° n 6ntered module nai ^ 
targetFolder = ^.Sn^JS^^^SJSrT 011 C ° ntainS " ticl ~ 
conversionsFolder = setConversionsFolder ("Conversions") converted «t.. and indexes 

Documents .Open 

f i 1 eName : =do cMap , 

ConfirmConversions7=False / 
addToRecentFiles:=False, ' ~ 

Format : =wdOpenFormltText , ~ i 
Readonly :=True s ~ , 

Documents. Open _ ° Pen dOCmap file 

fileName:=linkMap, _ 
ConfirmConversions:=False, 
addToRecentFiles :=False, ' ~ 
Format : =wdOpenFormatText , ~ 

Readonly :=True ~ * n . , 

curdle = Cir,"-, . ,wom„ 3Dir e«or yl '"S^Lt fll 

currFile = StrConvf currFile, vbLowerCase) r6trieve flrst ^ 

linkMapWindow = linkMap 
docMapWindow = docMap 



*yDebug. Print currFile 
vyDebug. Print workingDirectory 



s &o While currFile <> * it +. • 



extension part 

extPart = getExtPart (currFile) 

Select Case namePart > fi 

Case "credits" , " Check fllenam e cases 

Case "signon" .!S P conversio * for credits file 



Li 



v-aoc signon" !„,,■ . J - J - J - 

Case "menu" , ? COnversion for signon file 

Case "linkmap" , S J lp conve «i°* for menu file 

Case "docmap" t S Jt P conver sion for linkmap. lmf 

Case Else , P convers i°n for docMap.dmf 

Select Case extPart "° fllename e *ceptions, check extension cases 

Case "art" »„n 

Case "idx" , P COVersion £or «t holder files 

Documents. Open _ ^ CU " ent file " - 

f ileName : =currFile, 
■ - OonfirmConversions:=False, 
addToRecentFiles : =False, 

Format :=wdOpenFormatText ~ » ODe n currenf * 
currentFile = ActiveDocument.Name ZTt ZrlTt Al J™ Pr ° Ce3sin * 
currFileWindow = currentFile *J>L filename sans path 

preplndex rrentFile so we can activate document windows 

Case Else convert as index file 

Documents. Open _ ' a11 exce P tioi « checked for 

f ileName : =currFile, 

ConfirmConversions :=7alse, 

addToRecentFiles :=False, 

Format :=wdOpenFormatText ~ ^ OD en cur« n1 - * 
currentFile = ActiveDocument.Name Met cur^nt%ft Pressing 
currFileWindow = currentFile *?! current filename sans path 

currentFile » so we can activate document windows 




cof^RrtArticle *ok to do the standard conversion 

saveName = targetFolder & ":" & currFile & htmlHTML ^ 
' Debug; Print "targetFolder: " & targetFolder 

' Debug. Print "currFile: " & currFile 

' Debug. Print "saveName: " & saveName 

With Documents (currFile) 

. SaveAs f ileName : =saveName, FileFormat : =wdFormatText 
.Close 
End With 
End Select | 

End Select f ? 

currFile = Dir > ge t next file 

currFile = StrConv (currFile, vbLowerCase) 

Loop 

Documents (linkMap) .Close 
Documents (docMap) .Close 

Application. DisplayScrollBars = True 
'Application. DisplayStatusBar = True 
Application. ScreenUpdating-^= True 
End Sub 

PriSte Function getArticlePath ( ) As String 

The purpose of this function is to return the path 
for the articles to be converted 

s&ith Dialogs (wdDialogFileOpen) 
?js . Show 
y 4nd With 

n 

j 8 **** it doesn't matter if a file is opened or not, 
8 *~*** CurDir returns the last navigated path 
return value to calling 



13 *** 

getArticlePath = CurDir, 
End Function * 



Public Function getNamePart (ByVal fileName As String) As String 
Return the name-part of a filename 



t *** 
i ★ + ★ 



Dim dotLoc As Long 
dotLoc = InStr (fileName, ".") 
getNamePart = Left (fileName, dotLoc - 1) 
End Function 



Public Function getExtPart (ByVal fileName As String) As String 
t *+* 

'*** Return the extension part of a filename 
i * ★ * <.i 

Dim dotLoc As Long 
dotLoc = InStr (fileName, ".") 
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{^KeName, Len (f ileName) - dotLoc) 



getExtPart = Right 
End Function 15 

Public Function makeTargetFolder (ByVal targetFolder As String) As String 

+ + MkDir ==> create a folder based on the current path 
1 *** 



1 ++★ 
t *** 



The " ::" part makes it go up one level before creating the directory 

Dim saveDir As String J 4 

MkDir " ::" & targetFolder 'create target folder on the same level as working folder 

saveDir = CurDir 'save current folder to return to 

ChDir " ::" & targetFolder 'go to newly created folder 

makeTargetFolder = CurDir 'make the return value of this function be the created folder 
ChDir saveDir 'go back to working folder 

End Function 

Public Function setConversions Folder (ByVal cFolder As String) As String 
MkDir ==> create ar^f older based on the current path 

» *★* 

■ *+* The " ::" part makes it go up one level before creating the directory 

Dim ^sJaveDir As String 

%Q 

= fiaveDir = CurDir 'save current folder to return to 

fCfhDir " : : " & cFolder 'go to newly created folder 

J|etConversions Folder = CurDir 'make the return value of this funct. be the created folder 
[fehDir saveDir 'go back to working folder 

End function 



3 

Public Sub convertArticle ( ) 

I 



This file was created using FormatSpecialA thru D. 



i***^ These modules must be run in this order. 
1 ★ 



1^ 

• ★**«? Basically, do the article conversion 



multiReplace conversionsFolder & " : " & commentTags 'change raw tags to commented HTML 

specialText " [", "] htmlBoldStart, htmlBoldEnd, True, True 'replace [...] with 
<b>. . .</b> 

CreateTitle ..... "make window and article title 

HideHeaderlnfo "hide the med codes 

FooterCopyright "prettify copyright info and nix CRS 

PreformattedListsandTables "add preformatting tags to tables and menus 

1 

+ Note that prior to running Step 3.b, two files named 

+ * "linkmap.lmf " and "docmap.dmf " needed to be available. 
1 ★** 

t 

DocumentAnchor "make links to other docs and pics 

SectionLinks "make links at top to inner sections 

MakeParagraphs "format paragraphs 

MakeLists . 'format bulleted and numbered lists 
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InsertTopText 'insert top text template 

InsertBottomText Z 'insert bottom text template and tail&r to module 

End Sub. 



Option Explicit 

Public Sub CreateTitleO 
t ★ ★ ★ 

i*** This routine finds the delimited article title and uses it 

to create the windoj* title and the displayed article title. 

Assumes tagged ascia. format. * 
i*** This routine also adds the top and bottom tokens to the article. 
» + + * 

Dim docTitle As String 

Dim windowTitle As String 

Dim miss End As Boolean 

Dim gotWindowTitle As Boolean 

t *** 

docTitle = missingTitleDebug 'debugging title in case none found 

windowTitle = missingTitleDebug 'debugging title in case none found 

miss End = False ~* 

jSelection.HomeKey unit :=wdStory, Extend : =wdMove 'move to start of doc 
SimpleFind begTitleText 'find first title 

-?flbo While Selection . Find. Found 

^0 Selection. MoveDown unit : =wdParagraph x move to line following begTitleText - assume it 
is 4bc title 

Lfj Selection. ExtendMode = True 'selection mode on 

S E SimpleFind endTitleText 'selection includes title and end tag 

in If Selection. Find. Found Then 

*5S? X 

fn Selection. End = Selection. End - Len (endTitleText) 'deselect endTitletext leaving 

only title selected 

Selection. End = Selection. End - 1 'get rid of spurious cr 

fS Else 'jumpin jehosifat! no endTitleText tag found. 

r~ g missEnd = True 'Assume title is one paragraph. 

Select ion. MoveDown unit:=wdParagraph, Extend: =wdExt end 'move to end of hoped for 

tit^fe 

p End If 

^~ docTitle = Selection .Text 'save the title for cleaning 

If Not gotWindowTitlle Then 'only do if no windo title yet 

windowTitle = stripDelimiters (docTitle, paraDelimiter, " ") 'remove par. delimiter 
gotWindowTitle = True 'show that window title is already accounted for 

End If 

docTitle = sir ^Delimiters (docTitle, paraDelimiter, htmlBreak) 'replace paragraph 
delimiter with html break 

Selection. ExtendMode = False 

Selection. Text = htmlStartTitle & docTitle & htmlEndTitle 'replace selected text with 
cleaned title with html tags 

Selection . Collapse - wdCollapseEnd 

SimpleFind begTitleText 'find next title (subtitle in Spanish files) 

Loop 

SimpleFind endTitleText ' find end tag again 

If Selection. Find. Found Then 

Selection. Collapse wdCollapseEnd 

Selection. Text = vbCr & af terTitleTag & vbCr & TopLinkTag 'leave a tags after last 

title 
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Selection. Collapse wdCollapseEnd 
End If 5 . ^ 

Selection. HomeKey unit :~=wdS tor y *go back and insert top stuff for HTML & title 

Selection. Text = docTopToken & vbCr & htmlStartHead & _ 

windowTitle & htmlEndHead & vbCr ^insert token for start of doc and 

actual window title 

Selection. Collapse wdCollapseEnd 
If missEnd Then 

Selection. InsertAfter titleEndDebug & vbCr ^insert debug string 

Selection . Collapse ^dCo 11 apse End 

Selection. Text = vbCr & af terTitleTag & vbCr & TopLinkTag x leave a tags after last 

title 

End If 

Selection. EndKey unit :=wdStory *go to bottom and insert bottom stuff for HTML & footer 
Selection. Text = vbCr & docBottomToken & vbCr ^insert token for end of doc 

Selection. Collapse wdCollapseEnd 
End Sub 



Option Explicit 

Public Sub DocumentAnchor {-£ 
i *** 

f **"H Modify document such that index targets are true html anchors and all hyperlinks are 
trueShyperlinks 

^ This macro must be run on files with original names, i.e no ".html" extension 



t * + * 



TSirn currentSection As String ^linked title of section 

^tiim currentSectionText As String x body text between vTag and qTag 

;bim est As String ^abbreviation of currentSelectiontext 

MBim braceLoc As Long ^location of begLink tag in est 

ISim targetLetter As String ^letter between & "", link target! 

sDim currSectTarget As String x currentSection plus targetLetter 

C^im htmlLink As String ^resulting html link for targetLetter 

Id*** Initialize variables 
★ ★ ★ 

[3*** assumes every section title needs to also be an anchor 

f— 

Selection. HomeKey unit : : =wdS tor y *goto top of doc to know where we are 

SimpleFind cTag *find first (usually only) article start 
Do While Selection. Find. Found 

Selection. MoveDown unit :=wdParagraph *move to line following cTag - assume it is 
section title . « . 

Selection. Text = startAnchorToken ^insert token for start anchor definition 

Selection. Collapse wdCollapseEnd 

Selection. MoveDown unit :=wdParagraph, Extend: =wdExtend ^select rest of 

Selection. End = Selection. End - 2 ^deselect leaving only title selected 
Selection. Range. Case = wdLowerCase ^change selection case to lower so links will work 

currentSection = Selection. Text *save the title 

Selection. Collapse wdCollapseEnd *move to end of and deselect 

Selection. InsertAfter endAnchorToken & vbCr ^insert token for end anchor definition 

Selection. Collapse wdCollapseEnd 
i 

SimpleFind vTag *goto end of section header 

If Not Selection. Find. Found Then Selection. InsertAfter vTagDebug & vbCr 'hey, no vTag! 

Selection. MoveDown. unit: =wdParagraph *goto start of actual article body 
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Selection .ExtenaBae = True 
SimpleFind qTag ^ 'selection includes entire current section body 

If Not Selection. Find. Found Then 'now what, no qTag? 

Selection. ExtendMode = False 

Selection. InsertAfter qTagDebug & vbCr 'insert qTag debug message 

Selection. Collapse wdCollapseEnd 
Selection. ExtendMode = True 

Selection. EndKey unit : =wdStory 'fake it by moving to end 

End If 

Selection. ExtendMode = False 'end extend selection so next find won't change selection 

-* 

currentSectionText J= Selection. Text 'put section text into a string to be manipulated 

i +*★ 

i*** This next routine looks through the current section text, which is selected at this 

point, and embeds HTML links to any any sections referenced between braces, i.e. I, or 
**** A, etc. It will do this by copying the selection into a string variable and searching 
'*** for occurances of begLink and endLink, currently: 

- any single character - "". The and characters replaced the "<" and ">" 

characters in the mass replacements routine to not conflict with embedded html tags. 

The single character between the braces will be used along with currentSection$ to 
**** pull the target filename and section name out of the Link Map and Document Map arrays, 
i*** This action will be repeated until no more ? strings are found. 

Processing will then proceed with the next section, etc. 

Note that references that return a file named *.art will be handled specially since 
'***£ this is where the GIF thumbnail and link to the JPEG picture is inserted 

u "*2 est = currentSectionText 'needed a shorter name to work with 

=F braceLoc = InStr(cst, begLink) 'find location of "" which starts "?" 

Iff Do While braceLoc > 0 'if a brace was found 

ffl If Mid (est, braceLoc + 2, 1) = endLink Then 'if second following char is "" 

2 targetLetter = LCase (Mid (est, braceLoc +1, 1)) 'valid single index letter was 

foufgl 

[Q currSectTarget = currentSection + "~" & targetLetter 'build target for link 

mapl^rray 

f4 htmlLink = extractLink (currSectTarget ) 'extract target section from link map 

arrjay & file map array 

^2 est = Left (est, braceLoc - 1) & _ 

htmlLink & _ 

Right (est, (Len(cst) - (braceLoc +2))) 'build new section text 
including HTML link in place of "?" 

'remember: htmlLink might be debug text 
Else 'must have originally been an isolated "<" symbol 
est = Left (est, braceLoc - 1) & _ 
htmlLessThan & 

Right (est, (Len(cst) - braceLoc)) 'put the less than symbol back in 

End If 

* + ★ + 

start search after last "" found in case there are braces 
**** not of the "?" form, so it won't infinite loop 



**** 



braceLoc = InStr (braceLoc + 1, est, begLink) 'find location of next 

Loop 

currentSectionText = est 'go back to longer name 

Selection. Text = currentSectionText 'replaces currently selected section 

'text with newly built linked version 
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■V 



Selection. Collapse wdCollapseEnd 
SimpleFind cTag ^ *find next section 

Loop 
End Sub 

t********************************************************************** 

■ *** Extract target section from link map array & file map array 
t********************************************************************** 



Private Function extractLin|c (ByVal target As String) As String 

Dim currSection As String 

Dim linkSection As String 

Dim linkDoc As String 

Dim art As String 

Dim dot As Long 

Dim jpegName As String 

Dim gifName As String 



currSection = current File & "~ ,f & target 

linkSection = sectionToSection (currSection) 
Jf linkSection = missingLinkMapDebug Then 

M extractLink = linkSection 

%Q Documents (currFileWindow) .Activate 

V3 Exit Function 

K ind If 

[R-inkDoc = sectionToDoc (linkSection) 
B gf linkDoc = mi ssingDocMap Debug Then 
iR extractLink = linkDoc 

Documents (currFileWindow) .Activate 
Exit Function 



CP 



,=£nd If 



CI 



Documents (currFileWindow) .Activate 
art = Right (linkDoc, 3) 



'prepend current file to current section 
*name for use in the link from array 
*call to search link map file 
'check for missing linkmap target 
* return debug message 

'make sure we re-activate working window 



'call to read doc map file 
*check for missing docmap target 
'return debug message 

'make sure we re-activate working window 



'make sure we re-activate working window 
*Check to see if file to link to 
is of the form "♦.art 1 
this is an art ink 



for special handling 



'take only the file name sans ext. 
'build jpeg filename 
'buld gif filename 



5f art = "art" Then 

dot = InStr (linkDoc, ".") 

If dot > 1 Then linkDoc = Left (linkDoc, dot - 1) 
jpegName = linkDoc '& " . jpg" 
gifName = linkDoc & " . gif" 
extractLink = htmlBreak & htmlAStart & qq & artDir & jpegName & qq & _ 
htmlET & htmllmgStart & qq & artDir & gifName & qq & 
4 htmllmgEnd & htmlPressHere & htmlAEnd & htmlBreak 
Else 'this is a regular link 

extractLink = htmlBreak & htmlAStart & qq & 
linkSection & qq & htmlET & 

End If 
End Function 

i ********************************************************************** 
i*** reads link map file to find target section 

t ********************************************************************** 



linkDoc & html HTML & ttt & 
htmlGoThere & htmlAEnd 



Private Function sectionToSection (ByVal cs As String) As String 
i *** 

i*** cs = filename + + target letter 
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;t^^ 



ts = target sect! 
•*+* sts = line containing target section 

Dim ts As String 
Dim sts As String 
Dim firstTilde As Long 
Dim secondTilde As Long 




Documents (linkMapWindow) .Activate 
ts = 1 
sts = J 



"activates linkmap doc window 



Selection. HomeKey unit : =wdStory 



"go to top of doc 
"goes right to the proper line 



"extend selection to end of paragraph 
"don't include mark 



SimpleFind cs 

If Selection. Find. Found Then 

Selection. ExtendMode = True 
Selection. MoveDown unit : =wdParagraph 
Selection. End = Selection. End - 1 
Selection. ExtendMode = False 

sts = Selection. Teit "put selection into a string to be manipulated 

firstTilde = InStr(sts, "~") 'find location of 1st 

secondTilde = InStr (firstTilde + 1, sts, "~") "find location of 2nd "~" 

SsJ ts = Right (sts, (Len(sts) - (secondTilde + 2))) "extract target section 

\Ilse 

ts = missingLinkMapDebug 'target not found 

=pSnd If 

in 

_§ectionToSection = ts 
[documents (currFileWindow) .Activate 
End? function 



"return target section 

"activates current article doc window 



'reaSis doc map file to find target section 



Pri^te Function sectionToDoc (ByVal Is As String) As String 

i**^ is = link section returned by sectionTosection function 
i + * * ! 



Dim td As String 

Dim std As String 

Dim firstTilde As Long 

Documents (docMapWindow) .Activate 
td = 
std = 



"extracted target section 

"line containing target section 



"activate docmap doc 



Selection. HomeKey unit ^=wdStory 
SimpleFind Is 

If Selection. Find. Found Then 

Selection. ExtendMode = True 
Selection . MoveDown unit : =wdParagraph 
Selection. End = Selection. End - 1 
Selection. ExtendMode = False 
std = Selection. Text 



"start at top of document 
"goes right to the proper line 



"extend selection to end of paragraph 
"don't include mark 

"put selection into a string to be manipulated 
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firstTilde = InSt^td, 
td = Right (std, (L£n(std) - firstTilde)) 

Else 

td = missingDocMapDebug 
End If 

sectionToDoc = td 

Documents (currFileWindow) .Activate 
End Function 



"find location of 1st "~" 
^extract target section 

^target not found 

^return target 

^activates current article doc window 



Option Explicit I 
Public Sub FooterCopyright ( ) 
f ooterSection crTag 
f ooterSection fTag 
deleteCRSCopyright 



*do "/copyright" case 
Mo " . F" case 
x strip CRS Copyright 



If Not bottomRule Then *add horizontal rule if not added in footer routiners above 

Selection. HomeKey unit : =wdStory ^always know where you are (top) 

SimpleFind qTag 
If Selection. Find. J£ound Then 

Selection . Collapse wdCollapseStart 

Selection. Text = htmlHorizontalRule & vbCr 

bottomRule = True 

^ Else 

SimpleFind docBottomToken 
If Selection. Find. Found Then 

Selection. Collapse wdCollapseStart ^insert in front of docBottomToken 

Selection. Text = htmlHorizontalRule & vbCr *add horizontal rule rule 

3 p bottomRule = True *we added a bottom rule 

[fl End If *hey if we can't find the bottom at this point we're in trouble 

m End If 

E Selection. Collapse wdCollapseEnd 
?£nd If 



t«3 



^insert in front of qTag 
y add horizontal rule rule 
*we added a bottom rule 

*find doc bottom a different way 



Endjjub 



PubH 



c Sub f ooterSection (footerType As String) 
***** beautify article copyright footer section 



Selection. HomeKey unit :=wdStory 
SimpleFind footerType 
Do While Selection . Find. Found 
bottomRule = True 



* always know where you are (top) 
^find footer tag 
*works for either 
*set global flag to prevent double <hr> at bottom 



Selection. Text = footerType & htmlStartArticleFooter *start of footer section HTML 
Selection. Collapse wdCollapseEnd 

SimpleFind qTag x go to end of article copyright footer 

If Selection. Find. Found Then 

Selection. ExtendMode = False *end extend selection 

Selection. Collapse direction :=wdCollapseStart ^insertion point at start of .Q tag 
Selection. InsertAfter htmlEndArticleFooter & vbCr *end of footer HTML 

Selection. Collapse wdCollapseEnd 

Else 

Selection. EndKey unit : =wdStory ^move to end to add end Q tag 

Selection. InsertAfter htmlEndArticleFooter & qTagDebug & vbCr 'end of footer HTML 

(hopefully!) 

Selection. Collapse wdCollapseEnd 
End If 
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SimpleFind footer^pe 'satisfy while condition 

Loop ^ 
End Sub 

Public Sub deleteCRSCopyright ( ) 
i + + ★ 

»*** Strip CRS copyright, if it exists, since it is added later 
t *** 

Selection. HomeKey unit ^=wdStory 'always know where you are (top) 

PatternFind wildCopyRig*ht 'uses ???? pattern matching to allow all years 

If Selection. Find. Found Then 

Selection. MoveUp unit : =wdParagraph 'go to beginning of selection paragraph 
Selection. Range. Delete 'delete A p before 

Selection. MoveDown unit : =wdParagraph, Extend : =wdEx tend 'select para with copyright 

Selection. Text = deletedCopyrightDebug 'replace copyright with debug tag 

Selection. Collapse wdCollapseEnd 

Selection. ExtendMode = False 'cancel extend mode 

End If 
End Sub 



Opt:fecb Explicit 

Public Sub HideHeaderlnf o ( ) 

, **in This rountine comments out the header information of 
***tp the article which includes the med codes. 

! **tfl Assumes there is a link anchor on the line following the cTag 

5 

fS.election. HomeKey unit :=wdStory 'always know where you are (top) 

^impleFind cTag 'assume it is there 

1 ^Debug. Print "HideHeaderlnfo Find cTag selection, find, found = " & Selection. Find. Found 
^fio While Selection. Find. Found 

Selection. MoveDown unit :=wdParagraph, Count:=2 'move to line following anchor 

p Selection. InsertAfter htmlStartComment 'start of HTML comment 
r Selection. Collapse wdCollapseEnd 

SimpleFind vTag , 'find known end of header info 

1 Debug. Print "HideHeaderlnfo vTag = " & vTag 

1 Debug. Print "HideHeaderlnfo Find vTag selection. find. found = " & Selection. Find. Found 
If Selection. Find. Found Then 'make sure there is a vTag 

Selection. MoveLeft Count: =2 'deselect vTag leaving only header info selected 

Selection. InsertAfter htmlEndComment & vbCr 'end of HTML comment plus a newline 

Selection. Collapse wdCollapseEnd 
Else 'uh-oh, no vTag ! 

Selection. InsertAfter htmlEndComment & vTagDebug & vbCr 'insert a debugging 
comment, vTag missing 

Selection. Collapse wdCollapseEnd 
End If 

SimpleFind cTag 'in case there is another section - satisfy while 

Loop 
End Sub 

i 

Option Explicit 
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These constants aroused in searches 




t 4- -A- * 














Public 


Const 


crTag 




String ~ 






rUDXic 


Cons t 


L 1 ay 


Ac 


C 4- y i rirr = 
•j xiiy — 


"<!-- .F — >" 




Public 


Const 


qTag 


a e 

r\o 


O L. £, uiy — 


"<! — .Q — >" 




Public 


Cons t 








"<!— .C ~>" 




Public 


Const 


VI ay 






"<! — .V — >" 




Public 


Const 


hpTag 




o l. x. xiiy — 


"/hp" "primary heading tag 


Public 


Const 


pTag 


As 


String = 


"/p" "paragraph tag 




Public 


Const 


bliTag 




String = 


"/bli " "bulleted list 


item tag 


rUDllC 


Const 


numi ag 




String = 


"/numitem " "numbered list 


item tag 


PUDllC 


Const 


let i ay 


As 


String = 


"/letteritem " "letter list item tag 


Public 


Const 


romTag 


As 


String = 


"/letteritem " "roman numeral 


list item tag 


Public 


Const 


pCoinmentTag 


As String 


= "<!— /p 0/0 — >" 




PUDllC 


tonst 


npuommenc i ag 


Als String 


= "<! — /hp ~>" 




Public 


Const 


hpLastTag 


As String 


— s. I np laSt ' 




Public 
t 


Const 


TopLinkTag 


As String 


= "<!-- top link — >" 




Public 


Const 


begTitleText 


As 


String = 


v. : / U L. L. 




Public 
i 


Const 


endTitleText 




String = 


'•<! — /ett — >" 




Public 


Const 


beg2ColList 


As 


String = 


"<!-- /btwocollist — >" 




Pubi^c 


Const 


end2ColList 


As 


String = 


"<!-- /etwocollist — >" 




PublMc 


Const 


begBookList 


As 


String = 


'•<! — /bbooklist -->" 




Public 


Const 


endBookList 


As 


String = 


"<!-- /ebooklist 




Pubip.c 


Const 


begMenu As 


String = "<!- 


— /bmenu — >" 




Pubpflc 


Const 


endMenu As 


String = "<!- 


— /emenu — >" 




Public 


Cons t 


beaTable As 


String = "<! 


!-- /btable — >" 




Public 


Const 


endTable As 


String = "<! 


!— /etable ~>" 




iy 
Pub&ic 


Const 


begLink As 


String = 






Public 

S__S 


Const 


endLink As 


String = 







Publjc Const paraDelimiter 
Public Const linkMap 
Public Const docMap 



Public Const topText 

Public Const bottomText 

Public Const indexlReturn . 

text template is 

Public Const index2Return 

text template is 

Public Const mainlndexReturn 

link text template is 

Public Const HIILegal 

is 
t 

Public Const indexlToken 
link token 

Public Const index2Token 
link token 

Public Const mainlndexToken 



As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 


As 


String 



"linkmap.lmf" 
"docmap.dmf " 

"top.txt" "where the top text template is 
"bottom.txt" "where the bottom text template is 
"indexlReturn.txt" "where the index 1 return link 

"index2Return. txt" "where the index 2 return link 

"mainIndexReturn.txt" 'where the main index return 

"HIILegal.txt" "where the HII legal text template 

"<! — indexlReturn — >" 'where the index 1 return 
"<! — index2Return — >" 'where the index 2 return 
"<! — mainlndexReturn — >" 'where the main index 
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return link token 

Public Const HIILegalTokenZ As String = 

Public Const moduleToken As String = 

Public Const moduleToken2 As String 

Public Const moduleBackToken As String 
referenced" 




"<! — HIILegal — >" "where the HII J^egal text token 
"$module$" 'where the HII legal text token 
= "$module2$" "where the HII legal text token 
= M $moduleback$" "where the background image is 



Public Const coramentTags As String 

level as article folder 

Public Const afterTitleTag J As String 
last title 3 
Public Const tokensToHTML As String 

level as article folder 

Public Const addTopAndBottom As String 
same level as article folder 

These constants are used as inserted text 

i ★* + 

Public Const htmlParaStart 
Public Const htmlParaEnd 



"commentTags" "assume Conversions folder at same 
"<! — after title — >" 'used to show location after 
"tokensToHTML" "assume Conversions folder at same 
"addTopAndBottom" "assume Conversions folder at 



As String = "<p>" 
As String = "</p>" 



Public Const htmlBQStart 
Public Const htmlBQEnd 
• □ 

Public Const 
Pubi@.c Const 

Pubfjac Const 
Public Const 



htmlPreStart 
htmlPreEnd 



htmlBoldStart 
htmlBoldEnd 



As String = "<blockquote>" 
As String = "</blockquote>" 

As String = "<pre>" 
As String = "</pre>" 

As String = "<b>" 
As String = "</b>" 



Pubgc 


Const 


htmlStartArticleFooter 


As 


String 




"<! — start of footer — XBRXHRXBRXEM>" 


Public 


Const 


htmlEndArticleFooter 


As 


String 




"</EMXPXHR><! — end of footer — >" 


Pubfexc 


Const 


htmlStartComment 


As 


String 




"< ! — " 


Public 


Const 


html EndCommen t 


As 


String 




it ^.ii 


Puhp.c 


Const 


htmlStartHead 


As 


String 




"<! — start of header — ><HEADXTITLE>HII ■ 


PufcOlc 


Const 


htmlEndHead 


As 


String 




"</TITLEX/HEADX!~ end of header — >" 


Public 


Const 


htmlStartTitle 


As 


String 




"<H1 align=centerXB>" 


Public 


Const 


htmlEndTitle 


As 


String 




"</BX/Hl>" 


Public 


Const 


htmlTopLinkStart As String = "<brximg src=" & qq & ".. /images/bullet . gif" & < 










it 


align=TOP width=13 height=13><a href=" & qq 


"#" 
i 


'start 


of links at top of article 






Public 


Const 


htmlBreak 


As 


String 




"<br>" 


Public 


Const 


htmlHorizontalRule 


As 


String 




"<hr>" 


Public 


Const 


htmlLessThan , 


As 


String 




"<" 


Public 
i 


Const 


htmlGreaterThan 


As 


String 




">" 


Public 


Const 


htmlAStart 


As 


String 




"<A href=" 


Public 


Const 


artDir 


As 


String 




"art/" 


Public 


Const 


htmlET 


As 


String 






Public 


Const 


htmllmgStart 


As 


String 




"<IMG SRC=" 


Public 


Const 


html Img End 


As 


String 




" align=center vspace=30 hspace=30>" 


Public 


Const 


htmlPressHere 


As 


String 




"<font size=5><B>Press here to view a full 
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size picture, 


.</B></font> 1 ^^ 












Public Const 


htmlAEnd — 


As 


String 


— 


"</A>" 





Public Const 


htmlGoGif ^ 


As 


String 


s 


"go.gif" 


- 


Public Const 


htmlAlt 


As 


String 


— 


" alt=" 




Public Const 


html Go 


As 


String 




" (Go There) " 




Public Const 


html HTML 


As 


String 


— 


".html" 




Public Const 


htmlNo Border 


As 


String 


_ 


" border=0>" 




Public Const 


ttt 


As 


String 


= 






Public Const 


htmlGoThere 


As 


String 




"<img src=" "go.gif"" alt=" 


"Go There"" 


border=0>" 














Public Const 


qq 1 


As 


String 


= 


,,,,,,,, 'double quote 




Public Const 


docTopToken 


As 


String 




"<! — top of article — >" 




Public Const 
t 


docBottomToken 


As 


String 


— 


"<! — bottom of article — 


>" 


Public Const 


startAnchorToken 


As 


String 




"<p><A Name=" & qq 




Public Const 


endAnchorToken 


As 


String 




qq & "></a>" 




Public Const 


wildCopyRight 


As 


String 




"Copyright [1-2] [0-9] [0-9] 


[0-9] Clinical 



Reference Systems" 



'note ???? wildcard for year 



i *** 
i ★ + * 
» ★ + ★ 

Public 
& qgg& 
Public 
& qc^& 
PubiSc 

Public 

1 **-*J 



ASP Includes 

Const ASPdocmain 
H ^.ii 

Const ASPdochdrl 
ii 

Const ASPdochdr2 
it ^.ii 

Const ASPdochdr3 
ii ^.ii 



As String 
As String 
As String 
As String 



"<!— #include virtual=" 

"<!— #include virtual=" 

"<!— #include virtual=" 

"<! — #include virtual^" 



& qq & "/include/docmain.inc" 

& qq & "/include/dochdrl.inc" 

& qq & f, /include/dochdr2 .inc" 

& qq & f, /include/dochdr3 . inc" 



Inserted debugging tags 



Public Const endTagDebug 
Public Const vTagDebug 
PubO-c Const qTagDebug 
PubpL-ic Const pTagDebug 

Public Const missingParaDelamiterDebug 
Delimiter — >" 

Public Const missingTitleDebug 
Tag — >" 

Public Const titleEndDebug 
-->" 

Public Const deletedCopyrightDebug 
Public Const missingLinkMapDebug 
— >" 

Public Const missingDocMapD.ebug 
— >" 



As String 

As String 

As String 

As String 

As String 

As String 

As String 

As String 
As String 



"<!- 
"<!- 
"<!- 
"<!- 
"<!- 

"<!- 

"<!- 

"<!- 
"<!- 



Debug : 
Debug : 
Debug : 
Debug : 
Debug : 

Debug : 

Debug : 

Debug: 
Debug: 



Fake endTag — >" 
Missing vTag — >" 
Missing qTag — >" 
Missing pTag ~>" 
Missing Paragraph End 

Missing Article Title Start 

Missing Article Title End Tag 

Deleted Copyright — >" 
Missing target in linkmap.lmf 



As String = "< ! — Debug: Missing target in docmap.dmf 



Public Sub stripEndReturns {) 
Dim allClear As Boolean 

allClear = False 'initialize 

Selection. EndKey unit :=wdStory, Extend :=wdMove 'move to end of document 
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Do 

Selection. MoveLef tzgxtend: =wdExtend 'select last character 
If ( Selection. Text '= vbCr) Or (Selection. Text = vbCrLf) Then 

Selection. Text = MM 

Selection . Collapse wdCollapseStart 

Else 

allClear = True 

Selection. ExtendMode = False 'cancel selection extend 

End If 

Loop Until allClear | 

Selection. HomeKey unit :|=wdStory, Extend :=wdMove 'move to start of document 
End Sub 

i **★ 

Special handling for text which begins with startText 
and ends with endText 
»+** Enclose this text with HTML codes htmlOpen and htmlClose 

+ * deleteFirst is true if first character should be deleted (i.e a " [") 
deleteLast is true if last character should be deleted (i.e a "]") 

i **★ 

Public Sub specialText (ByVal startText As String, ByVal endText As String, _ 

ByVal htmlOpen As String, ByVal htmlClose As String, _ 
p ByVal deleteFirst As Boolean, ByVal deleteLast As Boolean) 

*- ri 

^election. HomeKey unit : =wdStory 'move to start of doc 

jSimpleFind startText 'find start of special text - if any 

l=|o While Selection. Find. Found 

="p 5 'move to beginning of selected text if startText not to be deleted 

If Not deleteFirst Then Selection. Collapse direction : =wdCollapseStart 



]L Selection. Text = htmlOpen 'HTML start text token, overwrites if deleteFirst 

Selection. Collapse wdCollapseEnd 
f^j SimpleFind endText 'find end delimiter 

!U if Selection. Find. Found Then 
O if Not deleteLast Then 

%J Selection. Collapse direction: =wdCollapseEnd 'move to end of selected text 

if fehdText not to be deleted 
End If 8 

Selection. Text - htmlClose "HTML end text token 

Selection. Collapse wdCollapseEnd 

Else 

Selection. EpdKey 'move to end of line, at least do one line 

Selection. Text = htmlClose 
Selection. Collapse wdCollapseEnd 
End If 

SimpleFind startText 'find next start of special text 

Loop 
End Sub 

Public Sub preformattedText (ByVal startTag As String, ByVal endTag As String) 
i *+* 

i*** Tnis routine requires a start tag and end tag. 

i*** Tne s tart tag is used to find and mark the beginning of 

•*** preformatted text blocks. 
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★ ★•J 

•k + 4 




The end tag is uJWFto find and mark the end of 
Preformatted text jplocks . 

The global constants htmlPreStart and htmlPreEnd are used. 
The are expected to be <pre> and </pre>, but don't have to be, 



Dim docText As String 
Dim paraLoc As Long 
Dim tagLen As Long 
Dim fakeEnd As Boolean 

fakeEnd = False ] 
i + + ★ 



'stores text to be cleaned of delimiter 

'place keeper for location of delimiter 

'used to subtract endTag from selection 

'keep track of when an endTag is forced 

'initialize 7 



Selection. HomeKey unit : =wdStory 
SimpleFind startTag 
Do While Selection. Find. Found 

Selection. Text = startTag & htmlPreStart 
Selection. MoveDown unit : =wdParagraph 
Selection. ExtendMode = True 
SimpleFind endTag 
If Selection. Find. Eound Then 
tagLen = Len (endTag) 
fakeEnd = False 

Else 

=!? SimpleFind fTag 

"J If Selection. Find. Found Then 

=^ tagLen = Len (fTag) 

S H fakeEnd = True 

: 0 Else 

*h SimpleFind crTag 

,fl If Selection. Find. Found Then 

Ifl tagLen = Len(crTag) 

s fakeEnd = True 

;3 Else 

Selection. EndKey unit : =wdStory, Extend: =wdEx tend 
art|gle as last resort 

O tagLen = 0 

fakeEnd = True 
End If 
End If 
End If 5 



'always know where you are (top) 
'find start of list if any 

'start of preformatted list 
'move to line following tag 

'selection includes table 
'legit endTag was found 



'force an end is none found 
'look for article footer 



'fTag was not found, keep looking 
'look for article copyright 



'crTag was not found, use last resort 

extend to end of 



'dont really have a tag 



Selection. ExtendMode = False 
Selection. End = Selection. End - tagLen 
docText = Selection. Text 
paraLoc = InStr (docText, paraDelimiter) 
Do While paraLoc > 0 

docText = Left (docText, paraLoc - 1) & 

Right (docText, Len (docText) - paraLoc) 'strip 
paraLoc = InStr (docText, paraDelimiter) 'find location of next 

Loop 



'end extend selection 

'deselect tag leaving only text selected 
'save the text for cleaning 
'find location of 
'only bother if there is a 



tag 



Selection. Text = docText 'replace selected text with cleaned text 

Selection. Collapse direction :=wdCollapseEnd 'collapse insertion point to start of end 



Selection. Text = htmlPreEnd 
Selection. Collapse wdCollapseEnd 
If fakeEnd Then 



'end preformatted list 



16 



m endTaaDebua x add sn^ri^i t- 



Selection. Te^= endTagDebug *add special tag to allow troubleshooting 

Selection. Collapse wdCollapseEnd ■= 
End If ~ 

SimpleFind startTag * look for more pre formatted text 

Loop 
End "Sub 



Public Function stripDelimiters (ByVal docText As String, 

ByVal delimiterText As String, 
| Optional ByVal replacelt As String = ,,M ) As String 

This function takes the passed docText string and replaces all occurances of 
delimiterText passed to it with the string replacelt. If the optional string replacelt 
is not passed, the delimiter is deleted rather than replaced. 



Dim delLoc As Long 'delimiter location in string 

Dim delLen As Long 'lenth of delimiter text 

delLen = Len (delimiterText) * ge t delimiter text length 

delLoc = mstr (docText-/ delimiterText) *find location of passed delimiter 

f Do While delLoc > 0 ^ on l y bother if there is a delimiter 

*~ docText = Left (docText, delLoc - delLen) & replacelt & 

^ Right (docText, Len (docText) - delLoc - delLen + 1) 'rebuild string with 

replaced or deleted delimiter 

4= delLoc =. InStr (docText, delimiterText) *find location of next delimiter in title 

-^ 00 P 'finished with this section 

StripDelimiters = Trim{docText ) *strip leading and trailing spaces 

End [function 

Public Function convertCharacter (ByVal inputString As String, 

□ ByVal v As String, 

in ByVal r As String) As String 

' **f . 

'**ri This function takes the passed input string and replaces all occurances of 

character "v" passed to it with the character in V. 

r tim vLoc As Long . 'delimiter location in string 

Dim outputString As String »pl ace to build output string 

Dim s As Long 'continue search from here 

outputString = "" 
s = 1 

I 

vLoc = InStr (inputString, v) ^find location of passed delimiter 

Do While vLoc > 0 * only bother if there is a delimiter 

outputString = outputString & Mid (inputString, s, vLoc - s) & r 'build output string 
with "v" replaced with "r" 
s = vLoc + 1 

vLoc = InStr(s, inputString, v) *find location of next "v" in string, start looking 
after last "v" y 

Lo °P 'finished with this section 

outputString = outputString & Right (inputString, Len (inputString) - s + 1) 
convertCharacter = outputString "strip leading and trailing spaces 

End Function 
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Public Sub InsertBottomText ( ) 
Dim bottomString As String' 
Dim indexlString As String 
Dim index2String As String 
Dim mainlndexString As String 
Dim HIILegalString As String 

bottomString = getFile (conversionsFolder & 
indexlString = getFile (conversionsFolder & 
mainlndexString = getFile (lonversionsFolder & 
HIILegalString = getFile ( conversionsFolder & 1 

Selection. HomeKey unit :=wdStory 
SimpleFind docBottomToken 
Selection. Collapse wdCollapseEnd 
Selection. Text = vbCr & bottomString 

Selection. HomeKey unit :=wdStory 
SimpleFind indexlToken.r 
Selection. Collapse wdCollapseEnd 
Selection. Text = indexlString 



& bottomText) 
& indexlReturn) 
':" & mainlndexReturn) 
" & HIILegal) 



x find where to stick bottom text 



^election. HomeKey unit :=wdStory 
agimpleFind mainlndexToken 
Jjelection . Collapse wdCollapseEnd 
^Selection. Text = mainlndexString 

I Selection . HomeKey unit : =wdStory 
JgimpleFind HIILegalToken 
^Selection . Collapse wdCollapseEnd 
JSelection.Text = HIILegalString 

SPelection. HomeKey unit :=wdStory 
&eplaceEvery moduleToken, moduleGif 
Selection. Collapse wdCollapseEnd 

n 

icy 

I'M secondlndex Then 

Selection. HomeKey unit :=wdStory 

index2String = getFile (conversionsFolder & ":" & index2Return) 
SimpleFind index2Token 
Selection . Collapse wdCollapseEnd 
Selection. Text. index2String 
Selection. HomeKey unit :=wdStory 
ReplaceEvery moduleToken2, moduleGif 2 
Selection. Collapse wdCollapseEnd 
End If 
End Sub 



Public Sub InsertTopText () 

Dim topString As String \ 
topString = getFile (conversionsFolder & " : " & topText) 

Selection. HomeKey unit : =wdStory j 

i 



:e^^ 'find where to sti^^t 



SimpleFind docTopToke^^ 'find where to sticlc top text 

Selection. Collapse wdCollapseEnd 
Selection. Text = vbCr & topString 

Selection. HomeKey unit : =wdStory 

SimpleFind cTag 

If Selection. Find. Found Then 

Selection. Text = ASPdochdrl & vbCr & cTag 'insert includes file ref 

Selection. Collapse wdCollapseEnd 
End If | 

Selection. HomeKey unit : =wdStory 
ReplaceEvery moduleBackToken, moduleBack 
Selection. Collapse wdCollapseEnd 
End Sub 



String 



'get next available file number 
'open external file for read 

'read in a line 
'build result string 

'close file 



moduleGif2 = "none" 'default to no gif 2 

Select Case moduleName 
Case "AHA" 

secondlndex = False 

moduleName = "AHA" 

moduleGif = "aha" 

moduleBack = "ahaback" 
Case "PA" 

secondlndex = False 

moduleName = "PedAdv" 

moduleGif = "pa" 

moduleBack = "paback" 
Case "BHA" 

secondlndex = True 

moduleName = "BHA" 

moduleGif = "bhal" 



Public Function getFile (ByVal fileName As String) As 



Read a complete file into a string 

Dim fileNumber As Long 
Dirn^ inputString As String 
*• 

[getFile = "" 
ij-ileNumber = FreeFile 

^ppen fileName For Input As #fileNumber 

^po While Not EOF (fileNumber) 

gn Line Input #fileNumber, inputString 

B p. getFile = getFile & inputString & vbCr 

l^oop 

~£lose #fileNumber 
End ^Function 

PubHc Sub tweakModuleName ( ) 

hi 

»+ + *^ Take entered module name and fix name, 
»*+*3 determine if there is a second index 
•**G and set lowercase name. 
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= T5na2" 'onlv BHA has a second in 



moduleGif2 = ^Ka2" 'only BHA has a second index in second gif (for now) 

moduleBack = *$>haback" 
Case "WHA" ~ 

secondlndex = False 
moduleName = "WHA" 
moduleGif = "wha" 
moduleBack = "whaback" 
Case "SHA" 

secondlndex = False 
moduleName = "SHA" 
moduleGif = "sSa" 
moduleBack = "shaback" 
Case "CA" 

secondlndex = False 
moduleName = "CA" 
moduleGif = "ca" 
moduleBack = "caback" 
Case "OA" 

secondlndex = False 
moduleName = "OA" 
moduleGif = "otf" 
moduleBack = "oaback" 
Case "SMA" 
[J secondlndex = False 

moduleName = "SMA" 
i.g moduleGif = "sma" 

j=. moduleBack = "smaback" 

= C Case "MA" 

P secondlndex = False 

^ moduleName = "MedAdv" 

JL? moduleGif = "ma" 

Kjl moduleBack = "maback" 

2 Case Else 

secondlndex = False 
^8 moduleName = "DebugMePlease" 

W moduleGif = "debugMe" 

C3 moduleBack = "debugmeback" 

Clnd Select 
End | Sub 



Option Explicit 
Public Sub Make2ColumnList () 

— * 

preformattedText beg2ColList, end2ColList *add Preformatting start end end tags to 2 
column lists 
End Sub 



Option Explicit 

Public Sub MakeBookList ( ) 

preformattedText begBookList, endBookList % add preformatting start end end tags to 
booklists 
End Sub 
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Option Explicit 
Public Sub MakeListsO 




* **★ 



Si? i°° kS ^ Vari ° US 1±St tags and Procasaes accordingly. 

Real html lists are created whenever possible. 



preltemList numTag 
preltemList letTag 
preltemList romTag 
preltemList bliTag 



bliltems "3/0" 
bliltems "7/4" 
End Sub 



'bliltems 



'use numbered item list pref ormatting 
'use letter item list Preformatting 
'use roman numeral item list Preformatting 4 
'use bulleted item list pref ormatting, except for simple case 
if simple bulleted list, create actual html list 
'prettify simple bulleted lists 
needs to be debugged for this case, leave as "pre" text for now 



Public Sub preltemList (ByVal listType As String) 



1 



r^r^fr S !! rChed f ° r the typSS ° f 1±St P assed to ifc a nd simply leaves it 
reformatted. This^s ugly, but works for the time being. 



Dim Paralnfo As String Contains the n/m indent information which goes with list taa 

S* ara J afl f f ring Xcontains ht ^ ^ring which is inserted at the beginnning of i£? 

Dim^ParaTag As String 'contains html string which is inserted at the end oHist 

Dim^stltem As String 'holds a copy of selected list text to process 

to 

Selection. HomeKey unit:=wdStorv ( ,,,„„„ . , 

fe e ri r cr > iistTwe *«- s 5 « ; r you are ,topi 

Jo While Selection. Find. Found 

IS Sel ec tion.MoveLeft 'leaves insertion point before hard return of previous paragraph 
CP Se^^ion. MoveDown unit:=wdParagraph We to beginning of tag Une 

* stltltZl T^tl^ htmlStartCo — t 'want to comment out tag" 

fl Selection. MoveRight Count^LenUistType) We to right of tag 

f6 f e l ec ^°n.Mo V eDown unit:=wdParagraph, Extend : =wdExtend 'select x/x info 

^ Selection. End = Selection. End - 1 'deselect hard return 



O 

U 



paralnfo = Trim (Selection. Text) 'save, cleaned selection 



M Selection. Collapse wdCollapseEnd 'deselect tag 

Selection.InsertAfte'r htmlEndComment * finish comme nting out tag 

Selection.MoveDown unit :=wdParagra P h We to beginning of body of list item 

If ^cL^SxS 11 ,if simple bulleted list ' *> — p«-»S 

Case "3/0" 

bParaTag = "<li>" 
eParaTag = " " 

Selection. MoveRight Extend: =wdExtend, Count:=3 Select dash and spaces 
Selection. Range. Delete Melete same 

Case "7/4" „ 

bParaTag = "<li>" 
eParaTag = " " 

Selection. MoveRight Extend: =wdExtend, Count:=7 Select dash and spaces 
Selection. Range. Delete Melete same 

Case Else 

other sort, use as = ht ^^raStart & htmlPreStart . vbCr 'indented paragraph of some 

eParaTag = vbCr 4 htmlPreEnd & htmlParaEnd 'leave as is until I have more 
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time 

End Select - -= 

Else " 

sort, use = htmlParaStart 4 htmlPreStart 4 vbCr Undented paragraph of some other 

End if 3 " 139 = VbCr & htmlp reEnd « htmlParaEnd 'leave as is until I have more time 

Selection. InsertAfter bParaTag * insert html a t 

Selection. CollapseawdCollapseEnd !. 
SimpleFind paraDelfniter > find end of list item J 

If Selection. Find. Found Then 

sl!^ 10 ""^ = ePa " Tag <re P lace token with html closing para tag 

Selection. Collapse wdCol lapse End 

Else 

/tag is fQun f leCti ° n - MoveUntil cset:=»/» We insertion point until the next beginning of a 

Selection.MoveLeft We to end Qf previos 

k . Selection, InsertAfter missingParaDelimiterDebug & eParaTag • insert a debua msa 

because end of list item tag wasn't found g g 



Selection. Collapse wdCollapseEnd 
End If 



Sioop 
End =Jub 



SimpleFind vbCr & listType * find start of next list 



Public Sub bliItems(ByVal indent As String) 

illjE ^ that 1±St ltem marked/ fi 9 ure out wh ^ch list items go together 

u t 

Dim^aralnfo As String Contains the n/m indent information which goes with list taa 

Dim^ParaTag As String Contains html string which is inserted at the beginning of 1 

Si^ff^^ 9 ? It"** ,contains -tml string which is inserted at the end oHist 

Dim^istltem As String 'holds a copy of selected list text to process 

OP Long 4holds location of /hp tag in listltem 



^election. HomeKey unit:=wdStory , alwa know where 

^mpleFind htmlStartComment fi bliTag & indent 'start of list 

fBb While Selection. Find ..Found 

Selection.MoveLeft ■ 

Select Case indent 
Case "3/0" 

Selection. InsertAfter »<ul>» & vbCr * ht ml tag for start of list 

Case 7/4 

Selection. InserUfter htmlBQStart & vbCr & -<ul>- & vbCr 'html tag for start of list 
Case Else 
End Select 

Selection.MoveDown unit : =wdParagraph 'prevent infinite loop if no /p 

Selection. ExtendMode. = True 'get tricky 

SimpleFind pCommentTag , find end of list _ ass 

If Selection. Find. Found Then 

listltem = Selection. Text , save selection to 

any ~ InStr (llstItem ' hpCommentTag) 'find first occurance of primary header, if 

Selection. ExtendMode = False 

If hpLoc = 0 Then 'no precluding /hp - an /hp tag would occur after end of list 
Selection. Collapse wdCollapseEnd 'collapse selection to end after pCommentTag 
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pCommentTag to inserf ' CoUnt : = Len (pCorr.nentTag, We insertion point to before 

Else 

Selection. MoveLeft * llSt " We know ifc is /hp -> 

End If now we're in the right spot 

^"selection.ExtendMode = False^ PCOmnentTag found to e "d list, look for next header 



'find end of list - assume next header 



SimpleFind hpCommentTag 
If Selection, Find. Found Then 
^Selection.Collapse wdCollapseStart \ right spot to insert </ul> 

SimpleFind htmlStartComment . bl iTag & indent 

Do While Selection. Find. Found 
thera are no interval/To? ^"artCo™ e „t . bllT , g . inde „t .fceep f indl „ a list item , 
Loop 

Selection. MoveDown unit:=wdParagraph u t . rt n<avt . . . 

SimpleFind htmlStartComment ^ find n ' "* Xt flnd / n next Paragraph 

Selection.Collapse wdCollapseStart *ln* ^ t0 liSt 

End If p scart collapse tostart of tag 

End If 



£3 

°E 

ill 

in 

2 

C3 



t ★ + + 

At this point we are at the presumed end of the simple bulleted list. 



x html tag for end of list 



Select Case indent 

Case "3/0" 
Selection. InsertAfter "</ul>" & vbCr 

Case "7/4" 

w "^"r^r""- ,,</ui> " * « < «r ea9 foc end of u . t 

□ End Select 

£3 

^± Selection. MoveDown unit:=wdParagraph ,„„ fc . ^ 

_ Sim P^Find htmlStartComment « biiTag « indent ^flnd . I ^ T ^ * f n ° /p ' /hp 

Loop y * inaenc "nd start of next list 

End Sub 



Option Explicit 
Public Sub MakeMenuf) 



preformattedText begMenu, endMenu 
End Sub 



*add Preformatting start end end tags to menus 



Option Explicit 
Public Sub MakeParagraphs<) 



» * + * 



Change /p tags into html paragraphs 
Dim paralnfo As String 



'info after the /p, e .g. 0/0 
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Dim bParaTag As String- 
Dim eParaTag As String^ 



'always know where you are 
'start of para tag 

'what? no /p? add debug message 

'don't bother with rest 



Selection. HomeKey unit :=wdStory 
SimpleFind vbCr & pTag 
If Not Selection. Find. Found Then 

Selection. InsertAfter pTagDebug 

Selection. Collapse wdCollapseEnd 

Exit Sub 

End If I 4 

Do While Selection. Find. Found 
Selection . MoveLeft 

Selection . MoveDown unit : =wdParagraph 

Selection. InsertAfter htmlStartComment 'want to comment out tag 

Selection. MoveRight Count: -3 'move to right of tag 

Selection. MoveDown unit :=wdParagraph, Extend :=wdExtend 'select x/x info 



m 
=^ 

m 

m 

B 

Q 
CO 
UJ 
P 

□ 



Selection. End = Selection. End - 1 

paralnfo = Select ion. Text 
paralnfo = Trim (palja Info) 

Selection . MoveRight 

Selection. InsertAfter htmlEndComment 
Selection . MoveDown unit : =wdParagraph 

Select Case paralnfo 



'deselect hard return 

'save selection 
'clean up info 



* finish comment 



Case "0/0" 






'simple paragraph 




bParaTag 




htmlParaStart 






eParaTag 




html Par aEnd 






Case "2/0" 






'simple paragraph 




bParaTag 




htmlParaStart 






eParaTag 




htmlParaEnd 






Case "0/4" 






'simple paragraph 




bParaTag 




htmlParaStart 






eParaTag 




htmlParaEnd 






Case "4/4" 






'indented paragraph 




bParaTag 




htmlBQStart 


'use blockquote to simulate 


indent 


eParaTag 




htmlBQEnd 






Case "4/5" 




i 


'indented paragraph 




bParaTag 




htmlBQStart 


'use blockquote to simulate 


indent 


eParaTag 




htmlBQEnd 






Case Else 










bParaTag 




htmlParaStart & htmlPreStart 


'indented paragraph of some 


sort 


eParaTag 




htmlPreEnd & htmlParaEnd 


'leave as is until I have more time 



End Select 

Selection. InsertAfter bParaTag 
Selection. Collapse wdCollapseEnd 
SimpleFind paraDelimiter 
If Selection. Find. Found Then 

Selection. Text = eParaTag 

Selection. Collapse wdCollapseEnd 
Else 'geeze, where' s the delimiter? 

Selection. InsertAfter missingParaDelimiterDebug 'insert yet a nother debug comment 

Selection. Collapse wdCollapseEnd 
End If 

SimpleFind vbCr & pTag 'find next paragraph 



'insert html para tag 
'find token for end of paragraph, namely 
'replace token with html closing para tag 
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Loop 
End Sub 



Option Explicit 

Public Sub MakeTables ( ) 

preformattedText begTable, endTable 'add pref ormatting start end end tags to tables 

End Sub ^ 

Option Explicit 

Public Sub multiReplace (ByVal pairsFile As String) 
i 

<*** Read pairs of find/ replace strings from an external file and perform ReplaceAll 
'*** Intended to replace the Add/Strip steps of the original conversion procedure, 
i *** 

'*** pairsFile => filename of the file containing the find/replace pairs 

»*** file format is as follows: 
i *** 

1 ***£3 x f Yt z * search, replace 

i * * * 

where: 

■***"« x => "1" or "0" mapped to "enabled", find/ replace is skipped if 

■***S3 enabled = "0" 

£.5 3 

• y => "1" or "0" mapped to "caseSensitive", case is ignored in 

search/ replace if caseSensitive = "0" 

z => "1" or "0" mapped to "useWildCards", wildcard search/replace is 

enabled if useWildCards = "1" 

search => search string mapped to "findString" 

if ^ 

****** replace => replace string mapped to "replaceString" 

***&Q 

note: if "findString" or "replaceString" have embedded double quotes <"> or commas 
' **I3 </>/ they appear in the conversion file as a bar character <|> or bullet <>, 

'**Ct respectively. The bar and bullet characters were used in the conversion file 

since the since the double-quote and comma characters are delimiters for the 
file read function. The "convertCharacter" function fixes this. 

i 

Dim fileNumber As Long 
Dim enabled As String 
Dim caseSensitive As String 
Dim useWildCards As String 
Dim findString As String 
Dim replaceString As String 

Reset 'make sure all low level access files are closed 

fileNumber = FreeFile *get next available file number 

1 Debug. Print pairsFile 
1 Debug. Print fileNumber 
' Debug. Print CurDir 

Open pairsFile For Input As tffileNumber 'open external file for read 

Do While Not EOF (fileNumber) 

Input #fileNumber, enabled, caseSensitive, _ 

useWildCards, findString, replaceString 'read in a find/ replace pair 
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findString = convej tCharacter (f indString, "I", Chr(34)) *make quotes real 

replaceString = coAvertCharacter (replaces t ring, "I"/ Chr(34)) *make qu6tes real 
findString = convertCharacter (findString, "", ",") ^rnake commas real 

replaceString = convertCharacter (replaceString, "", ",") ^rnake commas real 

'Debug. Print enabled 
'Debug. Print caseSensitive 
•Debug. Print useWildCards 
'Debug. Print findString ^ 

'Debug. Print replaceString J * 

'Debug. Print " " 

If enabled = "1" Then 
*call ReplaceAll method 

ActiveDocument . Content . Find . Clear Format ting 
ActiveDocument . Content . Find. Replacement . Clear Formatting 



With ActiveDocument . Content . Find 
.Text = findString 
. Replacement . Text = replaceString 
. Forward =*True 
.Wrap = wdFindContinue 
.Format = False 
4 f If caseSensitive = "1" Then 

.MatchCase = True 

'Z Else 

B H .MatchCase = False 

i[I End If 

=P .MatchWholeWord = False 

Ln If useWildCards = "1" Then 

rn .MatchWildcards = True 

5 Else 

p .MatchWildcards = False 

fQ End If 

i B ! .MatchSoundsLike = False 

P .MatchAllWordForms = False 

fk .Execute Replace: =wdReplaceAll 

End With 



? End If 
Loop i 

Close #1 'close file 

End Sub 



Option Explicit 

Public Sub PreformattedListsandTables ( ) 



preformattedText beg2ColList, end2ColList *add preformatting start end end tags to 2 
column lists 

preformattedText begBookList, endBookList x add preformatting start end end tags to 
booklists 

preformattedText begMenu, endMenu x add preformatting start end end tags to menus 
preformattedText begTable, endTable *add preformatting start end end tags to tables 
End Sub 



Option Explicit 
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Public Sub SectionLinks ( ) — — 
» **★ ^ 

'*++ Creates internal document links based upon 

section titles started by "/hp" tag aka "hpTag" . 

t ★ + + - 

Dim linkCount As Long * keeps a running count as to how many links have been made 

Dim sectionTitle As String x title of a subsection used to make a link at top of doc 

Dim linklndex As String *holds anchor index name 

Dim paraLoc As Long ^ 

■# * 
3 

linkCount = 0 
sectionTitle = 
linklndex = "" 

Selection. HomeKey unit : =wdStory *start at the top 

SimpleFind hpCommentTag *find first primary heading 

Do While Selection. Find. Found 

Selection.MoveDown unit : =wdParagraph *move to beginning of next paragraph 

Selection. ExtendMocJe = True 

SimpleFind " A p/" ^select to next if found 

If Selection. Find. Found Then * " A p/" was found 

f ~ Selection. End = Selection. End - 2 ^shrink selection to just title text 

Selection. ExtendMode = False 
^ linkCount = linkCount + 1 *point to next link, starts at "1" 

*~ linklndex = Format (linkCount ) *make count into a string, use Format ( ) for no 

lea<c§Jng space 

sectionTitle = Selection. Text *copy section title w/"" characters if any 

=h sectionTitle = stripDelimiters (sectionTitle, paraDelimiter, " ") 'clean section 

titj-fe of "" characters 

EP sectionTitle = stripDelimiters (sectionTitle, vbCrLf, " ") 'clean section title of 

hard return characters 

C3 sectionTitle = stripDelimiters (sectionTitle, vbCr, " ") 'clean section title of 

hai£<f return characters 

y 

insert the new text including tokens where html will be added in place of selection 



Selection. Text ? = htmlBreak & startAnchorToken & linklndex & _ 

endAnchorToken & sectionTitle & htmlParaEnd & hpLastTag 
Selection. Collapse wdCollapseEnd 

Selection. HomeKey unit :=wdStory *go to top of doc to insert link to just added 



anchor 



SimpleFind TopLinkTag *this is where the top links go 

Selection. Text = htmlTopLinkStart & linklndex & qq & _ 
htmlET & sectionTitle & htmlAEnd & _ 

vbCr & TopLinkTag ^insert actual link, leave top link for next one 
Selection. Collapse wdCollapseEnd 

SimpleFind hpLastTag *go back to where we left off 

Selection. Text T = Melete last seen tag 
End If 

SimpleFind hpCommentTag *find next primary heading 

Loop *while primary header found 

Selection. HomeKey unit :=wdStory *go back to top 

SimpleFind TopLinkTag *go back to end of last inserted link at top 

If Selection. Find. Found Then *make sure there were some links added 
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Selection. Text = vbCr & vbCr — 
Selection. Collapse wdCollapseEnd 

Selection. Text = ASPdochdr2 & vbCr "include dochdr2 for asp 

Selection. Collapse wdCollapseEnd 

Else 

SimpleFind af terTitleTag 'must assume this exists 

Selection. MoveDown unit :=wdParagraph 'move down to after main 

Selection. Collapse wdCollapseEnd 

Selection. Text = vbCr & ASPdochdr2 & vbCr "include dochdr2 for asp 

Selection. Collapse jrdCollapseEnd -* 
End If 

Selection. HomeKey unit :=wdStory "leave at top of doc 

End Sub 



The followiung is the macro which is used to convert indexes 
Some of the subroutines and functions have the same names as 
earlier referenced ^routines, but they are private to this macro set 
Listed as independent macro for temporary development use to facilitate 
Debugging and to permit slightly altered code in some subroutines 



Option Explicit 
Public indexName As String 
Public index2Name As String 
Public workingDirectory As String 
Public targetFolder As String 
Pub ike conversions Folder As String 
PubMc moduleName As String 
Public moduleGif As String 
PubiUc moduleGif2 As String 

Pubjtlc moduleBack As String "name of background gif 
Public secondlndex As Boolean 
W 

Public currentFile As String "so we only have to check once 
PubSlc currFileWindow As String 
'Pubiic linkMapWindow As String 
'Public docMapWindow As String 

Public namePart As String 
Public currAlpha As String 

Public Sub preplndexj) 
• **★ 

»+** set up parameters 

Application. DisplayScrollBars = False 
'Application. DisplayStatusBar = False 
Application. ScreenUpdating = False 

Dim currFile As String ; 

Dim extPart As String 

Dim saveName As String 

Dim messageText As String 

Dim moduleCount As Long 

currFile = 
saveName = 
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namePart = "" 
extPart = "" 



messageText = "Enter module code:" & vbCr & _ 

"AHA - Adult Health Advisor" & vbCr & _ 
"PA - Pediatric Health Advisor" & vbCr & _ 
"BHA - Behavioural Health Advisor" & vbCr & 
"WHA - Women's Health Advisor" & vbCr & _ 
"SItfV - Senior Health Advisor" & vbCr & _ 
"Of - Cardiac Health Advisor" & vbCr & 
"OA - Ophthalmology Health Advisor" & vbCr & 
"SMA - Sports Medicine Advisor" & vbCr & _ 
"MA - Medications Advisor" & vbCr 



moduleName = InputBox (messageText, "Module Name Entry", "AHA") 

tweakModuleName 'set some globals based on entered module name 

workingDirectory = getArticlePath ( ) 'get working directory which contains raw articles 

targetFolder = makeTarget Folder (moduleName) 'create a folder to save converted articles 
and indexes 

conversions Folder = sefeConvers ions Folde r ( "Conversions" ) 

currFile = Dir("") '(workingDirectory) 'retrieve first file 

CSurrFile = StrConv{ currFile, vbLowerCase) 

%\£)o While currFile <> "" 'null string is returned when no more files in folder 

3 f= namePart = getNamePart (currFile) 'seperate the current filename into namepart and 
extgfision part 

B £ extPart = getExtPart (currFile) 
lh ChDir workingDirectory 
ff% Documents .Open _ 

fileName:=currFile, _ 
" m ConfirmConversions :=False, _ 

"1% addToRecentFiles :=False, _ 

^ Format : =wdOpenFormatText 'open current file for processing 

1 j;^ current File = Acti veDocument . Name 'get current filename sans path 

convertlndex 'convert as index file 

O Documents (currFile) .Close savechanges :=wdDoNotSaveChanges 
r™ currFile = Dir ^ *get next file 

currFile = StrConvj currFile, vbLowerCase) 

Loop 

Application. DisplayScrollBars = True 
'Application. DisplayStatusBar = True 
Application. ScreenUpdating = True 
End Sub 



Private Sub convertlndex ( ) 
Dim linkText As String 
Dim saveName As String 
Dim n As Long 

Dim newSublndex As Document 

removeNonlndexLines *get rid of extraneous stuff 

For n = 65 To 90 

currAlpha = Chr(n) 

linkText = getCurrAlphaLinks 

Set newSublndex = Documents .Add 
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# 




Documents (newSublndex) .Activate — 

Selection. Text = lihkText 

Selection. Collapse wdCollapseStart 

formatlndexLinks 

Selection. HomeKey unit :=wclStory 

InsertTopText 

InsertBottomText 

ReplaceEvery " A p A p A p", vbCr 

saveName = targetFcider & " : " & namePart & & StrConv (currAlpha, vbLowerCase) & 

".asp" 1 * 

With Documents (newSublndex) 

. SaveAs f ileName : =saveName, FileFormat : =wdFormatText 
.Close 
End With 
Next n 
End Sub 

Private Sub formatlndexLinks ( ) 
Dim link As String 
Dim tildeLoc As Long 
Dim linkLen As Long 

i ★ ★ *0 

1 **^y Clean up non link lines 
i +**□ 

Selection. HomeKey unit :=wdStory 
RepijceEvery "- A p", ,,A p" 

»**tp~ format link lines 

i * + ★ 

a 

Selection. HomeKey unit : =wdStory 
Sim||eFind 

Do While Selection. Find. Found 

JgordBasic. Insert "<! >" 

^election .MoveDown unit : =wdParagraph, Extend: =wdExt end 
Selection. End = Selection. End - 1 
Kink = Selection. Text % 

Selection. Text = J 

tildeLoc = InStrdink, "~") 

linkLen = Len(link) 

link = Left (link, tildeLoc - 1) & ".asp#" & Right (link, linkLen - tildeLoc) 

link = "<a href=" & Chr(34) & link & Chr(34) & ">" 

Selection .Mo veUp unit : =wdParagraph 

Selection. Text = link 

Selection . Collapse wdCollapseEnd 

Selection. ExtendMode = True 

SimpleFind "<! 

Selection. ExtendMode = False 
Selection. End = Selection. End - 10 
Selection. Text = RTrim (Selection. Text) 
Selection. Collapse wdCollapseEnd 
Selection. Text = "</a>" 



Selection. Collapse wdCollapseEnd 
Selection. End = Selection. End + 10 
Selection. Text = 
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SimpleFind "~" z - 

Loop 
End Sub 

t * *★ 

■*** just search forward for the passed string 
i ★** 

Private Sub SimpleFind (ByVal findStr As String) 

1 

With Selection. Find | 
.Text = findStr 
.Forward = True 
.Format = False 
.MatchAllWordForms = False 
.MatchCase = False 
.MatchSoundsLike = False 
.MatchWholeWord = False 
.MatchWildcards = False 
.Wrap = wdFindStop__ 
. Execute 
End With 
End Sub 

n 

f * + *j3 search and replace forward using the passed strings for all occurances 

L: J 

Private Sub ReplaceEvery (ByVal findStr As String, ByVal replaceStr As String) 
[Selection. HomeKey unit :=wdStory 
fpfith Selection. Find 
I' -Text = findStr 
f~ .Replacement .Text = replaceStr 
Iq .Forward = True 
s\ .Format = False 
^ .MatchAllWordForms = False 

.MatchCase = False 
p .MatchSoundsLike = False 
^ .MatchWholeWord = False 

.MatchWildcards = False 

.Wrap - wdFindContinue 

.Execute Replace : =wdReplaceAll 
End With 

Selection. HomeKey unit : -wdStory 
End Sub 

Private Sub tweakModuleName ( ) 
i **★ 

+ * Take entered module name and fix name, 
determine if there is a second index 
!★*★ anc i se t lowercase name, 
i *** 

moduleGif2 = "none" 'default to no gif 2 

index2Name = "none" 'default to no index 2 



Select Case moduleName 
Case "AHA" 
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• 




secondlndex = -False — 
moduleName = "AHA" " 
moduleGif = "aha" 
moduleBack = "ahaback" 

indexName = "Adult Health Advisor Index" 
Case "PA" 

secondlndex = False 
moduleName = "PedAdv" 
moduleGif = "paj" 

moduleBack = "gaback" - ? 
indexName = "Pediatric Advisor Index" 
Case "BHA" 

secondlndex = True 
moduleName = "BHA" 
moduleGif = "bhal" 

moduleGif 2 = "bha2" 'only BHA has a second index in second gif (for now) 

moduleBack = "bhaback" 

indexName = "Behavioral Health Advisor Adult Index" 
index2Name = '^Behavioral Health Advisor Pediatric Index" 
Case "WHA" 

secondlndex = False 
moduleName = "WHA" 
moduleGif = "wha" 
moduleBack = "whaback" 

indexName = "Women's Health Advisor Index" 
F p Case "SHA" 

secondlndex = False 
moduleName = "SHA" 
moduleGif = "sha" 
moduleBack = "shaback" 
* r " indexName = "Senior Health Advisor Index" 

}j Case "CA" 

^ secondlndex = False 

*~ moduleName = "CA" 



□ 



moduleGif = "ca" 
moduleBack = "caback" 
indexName = "Cardiac Advisor Index" 
Case "OA" 

secondlndex = False 
moduleName = "OA" 
moduleGif = "oa" 
moduleBack = "oaback" 

indexName = "Ophthalmology Advisor Index" 
Case "SMA" 

secondlndex = False 
moduleName = "SMA" 
moduleGif = "sma" 
moduleBack = "smaback" 

indexName = "Sports Medicine Advisor Index" 
Case "MA" 

secondlndex = False 

moduleName = "MedAdv" 

moduleGif = "ma" 

moduleBack = "maback" 

indexName = "Medications Index" 
Case Else 

secondlndex = False 
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moduleName = "BebugMePlease" 
moduleGif = "debugMe" 
moduleBack = "debugmeback" 
indexName = "Debug Me Please Index" 
End Select 
End Sub 



Private Function getArticlePath ( ) As String 

'*** The purpose of this| function is to return the path -* 
»** + for the articles to be converted 
i **★ 
t 

With Dialogs (wdDialogFileOpen) 

. Show 
End With 

■*++ i t doesn't matter if a file is opened or not, 
i*** CurDir returns-sthe last navigated path 
!*** return value to calling 

q 

"getArticlePath = CurDir 
End^^unction 

Private Function ge t Name Par t (ByVal fileName As String) As String 
» * * #C 

! ***n Return the name part of a filename 

E Dim dotLoc As Long 
f^otLoc = InStr (fileName, ".") 
fftretNamePart = Left ( fileName, dotLoc - 1) 
End? (Function 

[3 

Private Function getExtPart (ByVal fileName As String) As String 

***** Return the extension part of a filename 

Dim dotLoc As Long 

dotLoc = InStr (fileName, ".") 

getExtPart = Right ( fileName, Len ( fileName) - dotLoc) 
End Function A 

Private Function makeTargetFolder (ByVal targetFolder As String) As String 

f +** MkDir ==> create a folder based on the current path 
i * + ★ 

'*** The part makes it go up one level before creating the directory 

f *** 

Dim saveDir As String 

MkDir & targetFolder 'create target folder on the same level as working folder 

saveDir = CurDir 'save current folder to return to 

ChDir & targetFolder *go to newly created folder 

makeTargetFolder = CurDir 'make the return value of this function be the created folder 
ChDir saveDir ^go back to working folder 

End Function 
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Private Function setConversj-onsFolder (ByVal cFolder As String) As String ^ 
i +** 

**** MkDir ==> create a folder based on the current path 
i *★ * 

I***' The part makes it go up one level before creating the directory 

Dim saveDir As String 

saveDir = CurDir 'save current folder to return to 

ChDir " : : " & cFolder ^ *go to newly created folder 

setConversionsFolder = frurDir 'make the return value of this function be the created 
folder 

ChDir saveDir x go back to working folder 

End Function 

Private Sub saveSublndex ( ) 

saveName = targetFolder & " : " & namePart & & currAlpha & ".asp" 

With Documents (newSublndex) 

.SaveAs f ileName : =saveName, FileFormat : =wdFormatText 

.CLose 
End Wi-fti 

End Sub 

n 

Prif^te Sub removeNonlndexLines ( ) 

f ***y Clean up PC formatted lines 

Selection. HomeKey unit :=wdS tor y 
ReplficeEvery vbCrLf, ,,A p" 
»**lfl 

f **|f1 remove extraneous text, leave only index lines 
t **# 

Sel£g:tion. HomeKey unit :=wdStory 
Self^tion.ExtendMode = True 
Siitf>ieFind "]" 

Selection. MoveDown unit : =wdParagraph 
Sel^eption.ExtendMode = False 
Selection. Text = 
i + + * 

deleted everything ? at the top at this point 

i * + ★ 

SimpleFind ,,/N p.Q" 
Selection. Text = "" 

-• * 

i ★ + ★ 

I*** deleted everything at the bottom at this point 
End Sub 

Private Sub InsertBottomText ( ) 
Dim bottomString As String 
Dim indexlString As String 
Dim index2String As String 
Dim mainlndexString As String 
Dim HIILegalString As String 

bottomString = getFile (conversionsFolder & ":" & "subIndexBottom.txt") 
indexlString = getFile (conversionsFolder & ":" & "indexlReturn.txt") 
mainlndexString = getFile (conversionsFolder & ":" & "mainIndexReturn.txt") 
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HIILegalString = getFile (conversions Folder & " : " & "HIILegal.txt") 
Selection. EndKey unit :=wdStory *go to bottom 

Selection. Text = vbCr & bottomString 
Selection. HomeKey unit : =wdStory 
SimpleFind "< ! — indexlReturn — >" 
Selection. Collapse wdCollapseEnd 
Selection. Text - indexlString 
Selection. HomeKey unit : =wdStory 
SimpleFind "<! — mainlqdexReturn — >" 
Selection. Collapse wdC<fl lapse End 
Selection. Text = mainlndexString 
Selection. HomeKey unit : =wdStory 
SimpleFind "<!— HIILegal ~>" 
Selection. Collapse wdCollapseEnd 
Selection. Text = HIILegalString 
Selection. HomeKey unit : =wdStory 
ReplaceEvery "$module$ , \ moduleGif 
Selection. Collapse wdCollapseEnd 
If secondlndex Then 

Selection . HomeKey -anit : =wdStory 

index2String = getFile (conversionsFolder & " : " & "index2Return.txt") 
» SimpleFind "<! — index2Return — >" 
fc 2 Selection. Collapse wdCollapseEnd 

Selection. Text = index2String 
% Z Selection. HomeKey unit : =wdStory 
rfc ReplaceEvery ,, $module2$ ,t , moduleGif 2 
4j Selection. Collapse wdCollapseEnd 
^End If 
End^Sub 

cn 

Public Sub InsertTopText ( ) 
DimliopString As String 

topfftring = getFile (conversionsFolder & ":" & "sublndexTop . txt" ) 
^election. HomeKey unit :=wdStory 
[^election. Text = topString & vbCr 
f Selection. HomeKey unit :=wdStory 
ptf namePart = "index" Then 

ReplaceEvery "$indexName$", indexName 
Else f 

ReplaceEvery "$indexName$", index2Name 
End If 

Selection. Collapse wdCollapseEnd 
Selection. HomeKey unit :=wdStory 
ReplaceEvery "$moduleback$", moduleBack 
Selection. Collapse wdCollapseEnd 
Selection. HomeKey unit :=wdStory 
ReplaceEvery "$A$", currAlpha 
Selection. Collapse wdCollapseEnd 
End Sub 

Public Function getFile (ByVal fileName As String) As String 
i *** 

' *** Read a complete file into a string 

Dim fileNumber As Long 
Dim inputString As String. 
getFile = 
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fileNumber = FreeFile 

Open fileName For Inputf As #f ileNumber 

Do While Not EOF (fileNumber) 

Line Input #f ileNumber, inputString 
getFile = getFile & inputString & vbCr 

Loop 

Close #fileNumber 
End Function 

Private Function getCurr Alalia Links ( ) As String 
Dim workingString As String 
Dim foundNext As Boolean 
Dim nextAlpha As String 
workingString = "" 
foundNext = False 

nextAlpha = Chr (Asc (currAlpha) + 1) 
Selection. HomeKey unit :=wdStory 
SimpleFind !,A p" & currAlpha 
If Not Selection. Find. Eound Then 

getCurrAlphaLinks -=* vbCr & vbCr 



x get next available file number 
*open external file for read 

*read in a line 
^build result string 

*close file 



*if you don't find it then git! 
there are no topics " & _ 

" & _ 
& 



& vbCr & "Sorry, 
"which begin with the letter 
£3 Chr (34) & currAlpha & Chr (34) 

'%y Exit Function 
*End If 

JBo While Selection. Find. Found 
|h Selection. ExtendMode = True 
_g SimpleFind " A p" & currAlpha 
f f&oop 

fiworkingString = workingString & Selection. Text 
^Selection. Text = "" 
^election. ExtendMode = False 
M + ★* 

need to make sure to handle indented section after last currAlpha 



c 



^election. ExtendMode = True 



•=bo Until foundNext Or Asc (nextAlpha) > 
^ SimpleFind ,,A p" & nextAlpha 



90 



& Selection. Text 



1) 



If Selection. Find. ?ound Then 
foundNext = True 
Selection. ExtendMode = False 
Selection. End = Selection. End 
workingString = workingString 
Selection. Text = "" 

Else 

nextAlpha = Chr (Asc (nextAlpha) + 
End If 

Loop 

If Asc (nextAlpha) > 90, Then 

Selection. EndKey unit :=wdStory 

workingString = workingString & Selection. Text 
Selection. Text = "" 
End If 

Selection. ExtendMode = False 
getCurrAlphaLinks = workingString 
End Function 



^deselect character and hard return 
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